home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / psgui130.zip / PGUIWIN.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-01  |  25KB  |  969 lines
  1. {
  2.  
  3.                                                       ╔══════════════════╗
  4.                                                       ║  PGUI Graphic    ║
  5.                                                       ║  Window Include  ║
  6.                                                       ║    Rev.  1.00    ║
  7.                                                       ╚══════════════════╝
  8.  
  9. }
  10.  
  11. Procedure GraphicWindow.SaveBackground;
  12. Begin
  13.   Mouse.Hide;
  14.   Size:=ImageSize(X1,Y1,X2,Y2);
  15.   If Size>MaxAvail Then Error(1);
  16.   GetMem(Save,Size);
  17.   GetImage(X1,Y1,X2,Y2,Save^);
  18.   Mouse.Show;
  19. End;
  20.  
  21. Procedure GraphicWindow.DrawWindow;
  22.  
  23. Var
  24.   X  :Byte;
  25.   Old:Record
  26.         Color:Word;
  27.         Style:FillSettingsType;
  28.       End;
  29.  
  30. Begin
  31.   Mouse.Hide;
  32.   Old.Color:=GetColor;
  33.   GetFillSettings(Old.Style);
  34.  
  35.   SetColor       (BoxBck);
  36.   Line(X1+1,Y1,X2-1,Y1);            {-----}
  37.   Line(X1,Y1+1,X1,Y2-1);            {|<  |}
  38.   Line(X2,Y1+1,X2,Y2-1);            {|  >|}
  39.   Line(X1+1,Y2,X2-1,Y2);            {-----}
  40.  
  41.   SetColor       (BoxFrg);
  42.   SetFillStyle   (Pattern,FillColor);
  43.   For X:=1 to Thickness do
  44.     Rectangle(X1+X,Y1+X,X2-X,Y2-X);
  45.   Inc(X);
  46.   Bar(X1+X,Y1+X,X2-X,Y2-X);
  47.  
  48.   PutPixel(X1+1,Y1+1,BoxBck);
  49.   PutPixel(X2-1,Y2-1,BoxBck);
  50.   PutPixel(X2-1,Y1+1,BoxBck);
  51.   PutPixel(X1+1,Y2-1,BoxBck);
  52.  
  53.   PutPixel(X1+X,Y1+X,BoxFrg);
  54.   PutPixel(X2-X,Y2-X,BoxFrg);
  55.   PutPixel(X2-X,Y1+X,BoxFrg);
  56.   PutPixel(X1+X,Y2-X,BoxFrg);
  57.  
  58.   SetColor(Old.Color);
  59.   SetFillStyle(Old.Style.Pattern,Old.Style.Color);
  60.   Mouse.Show;
  61. End;
  62.  
  63. Procedure GraphicWindow.Open(NX1,NY1,NX2,NY2,Forg,Back,
  64.                              Thick,Patrn,PatClr:Word;KeepBackground:Boolean);
  65. Begin
  66.   Buttons.Init;
  67.   HdrButtonNum        :=0;
  68.   VSlideButtonNum     :=0;
  69.   VSlideBarButtonNum  :=0;
  70.   VSlideButtonUpNum   :=0;
  71.   VSlideButtonDownNum :=0;
  72.   VSlideBarMaxPos     :=0;
  73.   VSlideBarCurPos     :=0;
  74.   HSlideButtonNum     :=0;
  75.   HSlideBarButtonNum  :=0;
  76.   HSlideButtonLeftNum :=0;
  77.   HSlideButtonRightNum:=0;
  78.   HSlideBarMaxPos     :=0;
  79.   HSlideBarCurPos     :=0;
  80.   VSlideBarPat        :=0;
  81.   VSlideBarClr        :=0;
  82.   HSlideBarPat        :=0;
  83.   HSlideBarClr        :=0;
  84.   CloseButtonNum      :=0;
  85.   KeepBack            :=KeepBackground;
  86.   Status              :=Visible;
  87.   Header              :='';
  88.   BoxFrg              :=Forg;
  89.   BoxBck              :=Back;
  90.   Thickness           :=Thick;
  91.   Pattern             :=Patrn;
  92.   FillColor           :=PatClr;
  93.   X1                  :=NX1;
  94.   Y1                  :=NY1;
  95.   X2                  :=NX2;
  96.   Y2                  :=NY2;
  97.  
  98.   If KeepBack Then
  99.     SaveBackground
  100.   Else
  101.   Begin
  102.     Size:=0;
  103.     Save:=NIL;
  104.   End;
  105.   DrawWindow;
  106. End;
  107.  
  108. Procedure GraphicWindow.DisplayHeading;
  109.  
  110. Var
  111.   XPos:Word;
  112.   Old :Record
  113.          Color:Word;
  114.          Style:FillSettingsType;
  115.        End;
  116.  
  117. Begin
  118.   Mouse.Hide;
  119.   GetFillSettings(Old.Style);
  120.   If Header<>'' Then
  121.   Begin
  122.     Old.Color:=GetColor;
  123.     SetColor       (HdrFrg);
  124.     SetFillStyle   (HdrPattern,HdrFillColor);
  125.     Bar(X1+Thickness+2,Y1+Thickness+2,X2-Thickness-2,Y1+Thickness+12);
  126.     Case HdrFmt Of
  127.       LeftText  :XPos:=X1+4;
  128.       CentreText:XPos:=X1+((X2-X1) Div 2)-(Length(Header)*4);
  129.       RightText :XPos:=X2-2*Thickness-(Length(Header)*8)-2;
  130.     End;
  131.     OutTextXY(XPos+Thickness,Y1+4+Thickness,Header);
  132.     SetColor(Old.Color);
  133.   End
  134.   Else
  135.   Begin
  136.     SetFillStyle   (Pattern,FillColor);
  137.     Bar(X1+Thickness+2,Y1+Thickness+2,X2-Thickness-2,Y1+Thickness+12);
  138.   End;
  139.   SetFillStyle(Old.Style.Pattern,Old.Style.Color);
  140.   Mouse.Show;
  141. End;
  142.  
  143. Procedure GraphicWindow.NewHeading(NewHead:String;NewMode:TextFormats;
  144.                                    Forg,Patrn,PatClr:Word);
  145. Begin
  146.   HdrFrg:=Forg;
  147.   HdrPattern:=Patrn;
  148.   HdrFillColor:=PatClr;
  149.   HdrFmt:=NewMode;
  150.   If NewHead='' Then
  151.     Header:=''
  152.   Else
  153.     Header:=NewHead;
  154.   DisplayHeading;
  155. End;
  156.  
  157. Procedure GraphicWindow.Hide;
  158.  
  159. Var
  160.   NewSave :Pointer;
  161.  
  162. Begin
  163.   Status:=Hidden;
  164.   If KeepBack Then
  165.   Begin
  166.     If Size>MaxAvail Then Error(1);
  167.     GetMem(NewSave,Size);
  168.     Mouse.Hide;
  169.     GetImage(X1,Y1,X2,Y2,NewSave^);
  170.     PutImage(X1,Y1,Save^,NormalPut);
  171.     Mouse.Show;
  172.     FreeMem(Save,Size);
  173.     Save:=NewSave;
  174.   End
  175.   Else
  176.   Begin
  177.     Mouse.Hide;
  178.     SetFillStyle(SolidFill,BoxBck);
  179.     Bar(X1,Y1,X2,Y2);
  180.     Mouse.Show;
  181.   End;
  182. End;
  183.  
  184. Procedure GraphicWindow.Show;
  185.  
  186. Var
  187.   NewSave :Pointer;
  188.  
  189. Begin
  190.   Status:=Visible;
  191.   If KeepBack Then
  192.   Begin
  193.     If Size>MaxAvail Then Error(1);
  194.     GetMem(NewSave,Size);
  195.     Mouse.Hide;
  196.     GetImage(X1,Y1,X2,Y2,NewSave^);
  197.     PutImage(X1,Y1,Save^,NormalPut);
  198.     Mouse.Show;
  199.     FreeMem(Save,Size);
  200.     Save:=NewSave;
  201.   End
  202.   Else
  203.   Begin
  204.     DrawWindow;
  205.     DisplayHeading;
  206.     If CloseButtonNum<>0 Then
  207.       PutImage(X1+Thickness+2,Y1+Thickness+2,IconCloseButton^,CopyPut);
  208.     If VSlideButtonNum<>0 Then DrawVertSlideBar;
  209.     If HSlideButtonNum<>0 Then DrawHorzSlideBar;
  210.   End;
  211. End;
  212.  
  213. Procedure GraphicWindow.NewPosition(NewX,NewY:Word);
  214. Begin
  215.   Hide;
  216.   Buttons.MoveAll(Integer(NewX)-X1,Integer(NewY)-Y1);
  217.   X2:=NewX+(X2-X1);
  218.   Y2:=NewY+(Y2-Y1);
  219.   X1:=NewX;
  220.   Y1:=NewY;
  221.   Show;
  222. End;
  223.  
  224. Procedure GraphicWindow.DrawOutLine(NewX,NewY:Word;Var OutLine:OutLineSave);
  225.  
  226. Var
  227.   OldClr:Word;
  228.  
  229. Begin
  230.   X2:=NewX+(X2-X1);          {Saves the outline screen area of a box}
  231.   Y2:=NewY+(Y2-Y1);          {and then draws the outline of the box.}
  232.   X1:=NewX;                  {Saves the old screen area into OutLine.}
  233.   Y1:=NewY;
  234.   With OutLine do
  235.   Begin
  236.     Size1:=ImageSize(X1,Y1,X2,Y1);   {Horizontal}
  237.     Size2:=ImageSize(X1,Y1,X1,Y2);   {Vertical}
  238.     If 2*Size1+2*Size2>MaxAvail Then Error(1);
  239.     GetMem(Data[1],Size1);
  240.     GetMem(Data[2],Size1);
  241.     GetMem(Data[3],Size2);
  242.     GetMem(Data[4],Size2);
  243.     Mouse.Hide;
  244.     GetImage(X1,Y1,X2,Y1,Data[1]^);
  245.     GetImage(X1,Y2,X2,Y2,Data[2]^);
  246.     GetImage(X1,Y1,X1,Y2,Data[3]^);
  247.     GetImage(X2,Y1,X2,Y2,Data[4]^);
  248.     Mouse.Show;
  249.   End;
  250.   OldClr:=GetColor;
  251.   SetColor(BoxFrg);
  252.   Mouse.Hide;
  253.   Rectangle(X1,Y1,X2,Y2);
  254.   Mouse.Show;
  255.   SetColor(OldClr);
  256. End;
  257.  
  258. Procedure GraphicWindow.NoOutLine(Var OutLine:OutLineSave);
  259. Begin
  260.   With OutLine do
  261.   Begin
  262.     Mouse.Hide;
  263.     PutImage(X1,Y1,Data[1]^,NormalPut);  {Restores the screen to as it}
  264.     PutImage(X1,Y2,Data[2]^,NormalPut);  {was before DrawOutLine was called.}
  265.     PutImage(X1,Y1,Data[3]^,NormalPut);
  266.     PutImage(X2,Y1,Data[4]^,NormalPut);
  267.     Mouse.Show;
  268.     FreeMem(Data[1],Size1);
  269.     FreeMem(Data[2],Size1);
  270.     FreeMem(Data[3],Size2);
  271.     FreeMem(Data[4],Size2);
  272.     Size1:=0;
  273.   End;
  274. End;
  275.  
  276. Procedure GraphicWindow.Drag;
  277.  
  278. Var
  279.   MouseL,
  280.   MouseR,
  281.   MouseM,
  282.   MouseMoved,
  283.   MouseRelease :Boolean;
  284.   OldMouseX,
  285.   OldMouseY,
  286.   MouseX,
  287.   MouseY,
  288.   MouseStartX,
  289.   MouseStartY,
  290.   MouseDistX,
  291.   MouseDistY,
  292.   NewX,
  293.   NewY,
  294.   OldX,
  295.   OldY         :Word;
  296.   C            :Char;
  297.   OldBut       :Pointer;
  298.   OldData      :OutLineSave;
  299.  
  300. Begin
  301.   OldBut:=Buttons.Buttons;
  302.   If Mouse.Active Then
  303.   Begin
  304.     C:=#1;
  305.     OldMouseX:=65535;
  306.     OldMouseY:=65535;
  307.     MouseStartX:=((X2-X1) Div 2) + X1;
  308.     MouseStartY:=(Y1+Thickness+4);
  309.     MouseDistX:=MouseStartX-X1;
  310.     MouseDistY:=MouseStartY-Y1;
  311.     Mouse.SetXY(MouseStartX,MouseStartY);
  312.   End;
  313.   MouseRelease:=False;
  314.   OldX:=X1;
  315.   OldY:=Y1;
  316.   Repeat
  317.     Repeat
  318.       MouseMoved:=False;
  319.       KeyBuffer(Clear);
  320.       DrawOutLine(X1,Y1,OldData);      {Flashing Outline of a Box}
  321.       NoOutLine(OldData);
  322.       If Mouse.Active Then
  323.       Begin
  324.         Mouse.GetStatus(MouseX,MouseY,MouseL,MouseR,MouseM);
  325.         If (MouseX<>OldMouseX) Or (MouseY<>OldMouseY) Then MouseMoved:=True;
  326.         If (Not MouseL) And (Not MouseR) Then MouseRelease:=True;
  327.       End;
  328.     Until KeyPressed Or MouseMoved Or MouseRelease;
  329.     If MouseMoved Then
  330.     Begin
  331.       If LongInt(MouseX)-LongInt(MouseDistX)<0 Then
  332.         OldMouseX:=0
  333.       Else
  334.         OldMouseX:=MouseX-MouseDistX;
  335.       If LongInt(MouseY)-LongInt(MouseDistY)<0 Then
  336.         OldMouseY:=0
  337.       Else
  338.         OldMouseY:=MouseY-MouseDistY;
  339.       If (OldMouseX+(